#Correlation Matrix RPS
#Alan Yan
#September 25th, 2020

#### SETUP ####
#clear environment
rm(list = ls())

#load libraries
library(pacman)
p_load(tidyverse,
       DeclareDesign,
       corrplot,
       Hmisc,
       xtable,
       gridExtra)

#load data
dt <- read_rds("01-data/clean-data")

#### FUNCTIONS ####
flattenCorrMatrix <- function(cormat, pmat) {
  ut <- upper.tri(cormat)
  data.frame(
    row = rownames(cormat)[row(cormat)[ut]],
    column = rownames(cormat)[col(cormat)[ut]],
    cor  =(cormat)[ut],
    p = pmat[ut]
  )
}

p_format <- function(x, ndp=3)
{
  out <- format(round(as.numeric(x),ndp),ns=ndp,scientific=F,just="none")
  ifelse(out=="0.05","<0.05", out)
}

# x is a matrix containing the data
# method : correlation method. "pearson"" or "spearman"" is supported
# removeTriangle : remove upper or lower triangle
# results :  if "html" or "latex"
# the results will be displayed in html or latex format
#http://www.sthda.com/english/wiki/elegant-correlation-table-using-xtable-r-package
corstars <-function(x, method=c("pearson", "spearman"), removeTriangle=c("upper", "lower"),
                    result=c("none", "html", "latex")){
  #Compute correlation matrix
  require(Hmisc)
  x <- as.matrix(x)
  correlation_matrix<-rcorr(x, type=method[1])
  R <- correlation_matrix$r # Matrix of correlation coeficients
  p <- correlation_matrix$P # Matrix of p-value 
  
  ## Define notions for significance levels; spacing is important.
  mystars <- ifelse(p < .0001, "****", ifelse(p < .001, "*** ", ifelse(p < .01, "**  ", ifelse(p < .05, "*   ", "    "))))
  
  ## trunctuate the correlation matrix to two decimal
  R <- format(round(cbind(rep(-1.11, ncol(x)), R), 2))[,-1]
  
  ## build a new matrix that includes the correlations with their apropriate stars
  Rnew <- matrix(paste(R, mystars, sep=""), ncol=ncol(x))
  diag(Rnew) <- paste(diag(R), " ", sep="")
  rownames(Rnew) <- colnames(x)
  colnames(Rnew) <- paste(colnames(x), "", sep="")
  
  ## remove upper triangle of correlation matrix
  if(removeTriangle[1]=="upper"){
    Rnew <- as.matrix(Rnew)
    Rnew[upper.tri(Rnew, diag = TRUE)] <- ""
    Rnew <- as.data.frame(Rnew)
  }
  
  ## remove lower triangle of correlation matrix
  else if(removeTriangle[1]=="lower"){
    Rnew <- as.matrix(Rnew)
    Rnew[lower.tri(Rnew, diag = TRUE)] <- ""
    Rnew <- as.data.frame(Rnew)
  }
  
  ## remove last column and return the correlation matrix
  Rnew <- cbind(Rnew[1:length(Rnew)-1])
  if (result[1]=="none") return(Rnew)
  else{
    if(result[1]=="html") print(xtable(Rnew), type="html")
    else print(xtable(Rnew), type="latex") 
  }
} 

#### RPS COMPOSITE CORRELATION MATRIX ####
#cor_matrix.rps.attitudes <- dt %>%
#  filter(
#    (gc == 1 | gc == 3) &
#      attn_check == 1 
#  ) %>%
#  drop_na(auth_index,
#          r_religious_imp_n,
#          shame,
#          anger,
#          idimpt_n,
#          closeness_diff,
#          stereotype,
#          linked_fate_n,
#          discblacks_n) %>% 
#  select(
#    auth_index,
#    r_religious_imp_n,
#    shame,
#    anger,
#    idimpt_n,
#    closeness_diff,
#    stereotype,
#    linked_fate_n,
#    discblacks_n,
#    rps_index,
#    rps_attribution,
#    rps_concern
#  ) %>%
#  as.matrix() %>%
#  rcorr() 
#
#png("03-plots/appendix-fig-e.png", height = 1100, width = 1100)
#
#cor.plot <- corrplot(cor_matrix.rps.attitudes$r,
#                     type = "upper",
#                     order = "hclust", 
#                     p.mat = cor_matrix.rps.attitudes$P, 
#                     sig.level = 0.05, 
#                     insig = "p-value",
#                     tl.col = "black")
#
#dev.off()

#### *TABLE ####
png("03-plots/appendix-fig-e.png", height = 360, width = 1000)

cor.table <- dt %>%
  filter(
    (gc == 1 | gc == 3) &
      attn_check == 1 
  ) %>%
  drop_na(auth_index,
          r_religious_imp_n,
          shame,
          anger,
          idimpt_n,
          closeness_diff,
          stereotype,
          linked_fate_n,
          discblacks_n,
          rps_index,
          rps_attribution,
          rps_concern) %>% 
  select(
    auth_index,
    r_religious_imp_n,
    shame,
    anger,
    idimpt_n,
    closeness_diff,
    stereotype,
    linked_fate_n,
    discblacks_n,
    rps_index,
    rps_attribution,
    rps_concern
  ) %>%
  as.matrix() %>%
  corstars(.) %>%
  tableGrob()

grid.arrange(cor.table)

dev.off()


